home *** CD-ROM | disk | FTP | other *** search
- { TjocTable2 - implements additional BDE functional for TjocTable
- This is the new improved version with even more added features
-
- Copyright John O'Connell 1996
- All rights reserved
- }
-
- unit Tjtable2;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes;
-
- type
- TPassWdPriv = (prNone,prReadOnly,prModify,prInsert,prInsDel,prFull,prUnknown);
- TPasswdPrivs = set of TPassWdPriv;
- TDbiNameStr = string;
- TRecNoCap = (rnRecordNum, rnSequenceNum, rnUnsupported);
-
- TjocTable2 = class(TTable)
- private
- { Private declarations }
- FTblType: TDbiNameStr;
- FDeleted: Boolean; {is the record "soft" deleted}
- FRecNoCap: TRecNoCap; {sequence or record numbering supported}
- FBMStable: Boolean; {stable bookmarks?}
- FSoftDelCap: Boolean; {supports "soft" record deletion}
- FRecordNumber: LongInt;
- FShowDeleted: Boolean;
- FBlockSize: Word; {table block size}
- FTableLevel: Word; {table structure version}
- FProtected: Boolean; {is the table password protected?}
- FPasswords: Word; {number of auxiliary passwords}
- FTableRights: TPasswdPrivs;
- FRestructVer: Word; {number of times restructured}
- function GetDeleted: Boolean;
- {$IFNDEF Win32}
- function GetRecordNumber: LongInt;
- {$ENDIF}
- procedure InitTableProperties(const Cursor: HDBICur);
- procedure SetShowDeleted(const Value: Boolean);
- procedure BoolProp(const Value: Boolean);
- procedure WordProp(const Value: Word);
- procedure PasswdProp(const Value: TPasswdPrivs);
- procedure PackPdoxTable;
- function ChkRecLock: Boolean;
- function ChkShared: Boolean;
- function GetOpenCursors: Word;
- protected
- { Protected declarations }
- function CreateHandle: HDBICur; override;
- procedure CheckActiveExclusive;
- procedure CheckRemote;
- public
- { Public declarations }
- property Deleted: Boolean read GetDeleted;
- {$IFNDEF Win32}
- property RecNo: LongInt read GetRecordNumber;
- {$ENDIF}
- property StableBookMarks: Boolean read FBMStable;
- property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted default False;
- property IsRecordLocked: Boolean read ChkRecLock;
- property IsShared: Boolean read ChkShared;
- property OpenCount: Word read GetOpenCursors;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure UndeleteRecord;
- procedure GotoRecord(const RecNo: LongInt);
- procedure MoveRelative(const Delta: LongInt);
- function CountTableLocks(const LockType: DBILockType): Word;
- procedure LockRecord(const LockType: DBILockType);
- procedure UnlockRecord(const All: Boolean);
- procedure Flush;
- procedure Pack;
- {$IFNDEF Win32}
- procedure RenameTable(const RenameTo: string);
- {$ENDIF}
- procedure CopyTable(const Destination: string);
- procedure RebuildIndexes;
- procedure RebuildIndex(const Idx: word);
- procedure RebuildNamedIndex(const IdxName: TDbiNameStr);
- published
- { Published declarations }
- property BlockSize: Word read FBlockSize write WordProp;
- property TableLevel: Word read FTableLevel write WordProp;
- property IsProtected: Boolean read FProtected write BoolProp;
- property PasswordCount: Word read FPasswords write WordProp;
- property RestructVersion: Word read FRestructVer write WordProp;
- property TableRights: TPasswdPrivs read FTableRights write PasswdProp;
- end;
-
-
- function TransActive(ADatabase: TDatabase): Boolean;
- procedure Register;
-
- implementation
-
- uses DBConsts;
-
- function TransActive(ADatabase: TDatabase): Boolean;
- var XAct: XInfo;
- begin
- Result := False;
- Check(DbiGetTranInfo(ADatabase.Handle, nil, @XAct));
- Result := (XAct.exState = xsActive);
- end;
-
- constructor TjocTable2.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FShowDeleted := False;
- end;
-
- destructor TjocTable2.Destroy;
- begin
- inherited Destroy;
- end;
-
- procedure TjocTable2.BoolProp(const Value: Boolean);
- begin
- end;
-
- procedure TjocTable2.WordProp(const Value: Word);
- begin
- end;
-
- procedure TjocTable2.PasswdProp(const Value: TPasswdPrivs);
- begin
- end;
-
- function TjocTable2.ChkRecLock: Boolean;
- var WBool: Bool;
- begin
- Result := False;
- if State = dsInactive then DBError(SDataSetClosed);
- if State in [dsBrowse, dsEdit] then
- begin
- UpdateCursorPos;
- Check(DbiIsRecordLocked(Handle, WBool));
- Result := Boolean(WBool);
- end;
- end;
-
- function TjocTable2.CountTableLocks(const LockType: DBILockType): Word;
- begin
- Result := 0;
- if State = dsInactive then DBError(SDataSetClosed);
- Check(DbiIsTableLocked(Handle, LockType, Result));
- end;
-
- function TjocTable2.ChkShared: Boolean;
- var WBool: Bool;
- begin
- Result := False;
- if State = dsInactive then DBError(SDataSetClosed);
- Check(DbiIsTableShared(Handle, WBool));
- Result := Boolean(WBool);
- end;
-
- function TjocTable2.GetOpenCursors: Word;
- var szTabName: DBITBLNAME;
- szDBName, szTabType: DBINAME;
- TempDb: HDbiDb;
- RetCode: DBIResult;
- DBDescr: DBDesc;
- begin
- Result := 0;
- AnsiToNative(DBLocale, DatabaseName, szDBName, sizeof(szDBName) - 1);
- AnsiToNative(DBLocale, TableName, szTabName, sizeof(szTabName) - 1);
- AnsiToNative(DBLocale, FTblType, szTabType, sizeof(szTabType) - 1);
- {because DbiOpenTableCount can be called even if the table isn't open we
- must open a temporary database for the purpose of calling that function}
- Check(DbiGetDatabaseDesc(szDBName, @DBDescr));
- Check(DbiOpenDatabase(szDBName, DBDescr.szDBType, dbiREADONLY, dbiOPENSHARED,
- nil, 0, nil, nil, TempDB));
- RetCode := DbiGetTableOpenCount(TempDB, szTabName, szTabType, Result);
- DbiCloseDatabase(TempDB);
- Check(RetCode);
- end;
-
- procedure TjocTable2.LockRecord(const LockType: DBILockType);
- begin
- if State <> dsBrowse then
- DatabaseError('Cannot lock record in current dataset state');
- UpdateCursorPos;
- Check(DbiGetRecord(Handle, LockType, nil, nil));
- end;
-
- procedure TjocTable2.UnlockRecord(const All: Boolean);
- begin
- if State <> dsBrowse then
- DatabaseError('Cannot unlock record in current dataset state');
- UpdateCursorPos;
- Check(DbiRelRecordLock(Handle, All));
- end;
-
- procedure TjocTable2.InitTableProperties(const Cursor: HDBICur);
- const PrivRights : array[TPasswdPriv] of Word =
- (prvNONE, prvREADONLY, prvMODIFY, prvINSERT,
- prvINSDEL, prvFULL, prvUNKNOWN);
- var Props: CURProps;
- i: TPasswdPriv;
- begin
- Check(DbiGetCursorProps(Cursor, Props));
- case Props.iSeqNums of
- 0: FRecNoCap := rnRecordNum;
- 1: FRecNoCap := rnSequenceNum;
- else FRecNoCap := rnUnSupported;
- end;
-
- FSoftDelCap := Props.bSoftDeletes;
- FBMStable := Props.bBookMarkStable;
- FBlockSize := Props.iBlockSize;
- FTableLevel := Props.iTblLevel;
- FProtected := Props.bProtected;
- FPasswords := Props.iPasswords;
- FRestructVer:= Props.iRestrVersion;
-
- FTableRights := [];
- for i := prNone to prUnknown do
- if (Props.eprvRights and PrivRights[i]) = PrivRights[i] then
- Include(FTableRights, i);
- NativeToAnsi(DBLocale, Props.szTableType, FTblType);
- end;
-
- procedure TjocTable2.SetShowDeleted(const Value: Boolean);
- begin
- if State = dsInactive then DBError(SDataSetClosed);
- if (Value <> FShowDeleted) then
- begin
- if FSoftDelCap then
- begin
- Check(DbiSetProp(HDBIObj(Handle), curSOFTDELETEON, LongInt(Value)));
- FShowDeleted := Value;
- end
- else
- FShowDeleted := False;
- end;
- end;
-
- function TjocTable2.CreateHandle: HDBICur;
- begin
- Result := inherited CreateHandle;
- InitTableProperties(Result); {initialise table capabilities flags}
- end;
-
- procedure TjocTable2.CheckActiveExclusive;
- begin
- if not(Active and Exclusive) then
- DatabaseError('Table must be opened for exclusive use');
- end;
-
- procedure TjocTable2.CheckRemote;
- begin
- if Active and Database.IsSQLBased then
- DatabaseError('Operation not applicable for remote datasource');
- end;
-
- function TjocTable2.GetDeleted: Boolean;
- var Props: RECProps;
- begin
- Result := False;
- if State = dsInactive then DBError(SDataSetClosed);
-
- if FSoftDelCap then
- try
- UpdateCursorPos;
- Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
- Result := Props.bDeleteFlag;
- except
- Result := False;
- end;
- end;
-
- {$IFNDEF Win32}
- function TjocTable2.GetRecordNumber: LongInt;
- var Props: RECProps;
- begin
- Result := -1;
- UpdateCursorPos;
- Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
- case FRecNoCap of
- rnSequenceNum: Result := Props.iSeqNum;
- rnRecordNum: Result := Props.iPhyRecNum;
- end;
- end;
- {$ENDIF}
-
- procedure TjocTable2.UndeleteRecord;
- var Props: RECProps;
- begin
- if State = dsInactive then DBError(SDataSetClosed);
- if FSoftDelCap then
- begin
- UpdateCursorPos;
- Check(DbiUndeleteRecord(Handle));
- end;
- end;
-
- procedure TjocTable2.GotoRecord(const RecNo: LongInt);
- begin
- if State = dsInactive then DBError(SDataSetClosed);
- UpdateCursorPos;
- case FRecNoCap of
- rnSequenceNum: Check(DbiSetToSeqNo(Handle, RecNo));
- rnRecordNum: Check(DbiSetToRecordNo(Handle, RecNo));
- end;
- Refresh;
- end;
-
- procedure TjocTable2.MoveRelative(const Delta: LongInt);
- begin
- if State = dsInactive then DBError(SDataSetClosed);
- UpdateCursorPos;
- Check(DbiGetRelativeRecord(Handle, Delta, dbiNOLOCK, nil, nil));
- Refresh;
- end;
-
- procedure TjocTable2.Flush;
- begin
- if State = dsBrowse then
- Check(DbiSaveChanges(Handle));
- end;
-
- procedure TjocTable2.Pack;
- var SaveActive, SaveExcl: Boolean;
- begin
- SaveActive := Active;
- SaveExcl := Exclusive;
- try
- Close;
- Exclusive := True;
- Open;
- if CompareStr(FTblType, StrPas(szPARADOX)) = 0 then
- PackPdoxTable
- else
- if CompareStr(FTblType, StrPas(szDBASE)) = 0 then
- Check(DbiPackTable(Database.Handle, Handle, nil, nil, True))
- else
- DatabaseError(format('Cannot pack this table type (%s)', [FTblType]));
- finally
- Close;
- Exclusive := SaveExcl;
- Active := SaveActive;
- end;
- end;
-
- procedure TjocTable2.PackPdoxTable;
- var TblDesc: CRTblDesc;
- hDB: HDbiDb;
- RetCode: DBIResult;
- begin
- FillChar(TblDesc, sizeof(TblDesc), 0);
- AnsiToNative(DBLocale, TableName, TblDesc.szTblName, sizeof(TblDesc.szTblName)-1);
- AnsiToNative(DBLocale, FTblType, TblDesc.szTblType, sizeof(TblDesc.szTblType)-1 );
- TblDesc.bPack := True;
-
- hDB := Database.Handle;
- Close;
- Check(DbiDoRestructure(hDB, 1, @TblDesc, nil, nil, nil, False));
- end;
-
- {$IFNDEF Win32}
- procedure TjocTable2.RenameTable(const RenameTo: string);
- var hDB: HDbiDb;
- szRenFrom, szRenTo: DBITBLNAME;
- RetCode: DBIResult;
- SaveActive, SaveExcl: Boolean;
- begin
- SaveActive := Active;
- SaveExcl := Exclusive;
- try
- Close;
- Exclusive := True;
- Open;
- hDB := Database.Handle;
- Close;
- AnsiToNative(DBLocale, RenameTo, szRenTo, sizeof(szRenTo)-1);
- AnsiToNative(DBLocale, TableName, szRenFrom, sizeof(szRenFrom)-1);
- Check(DbiRenameTable(hDB, szRenFrom, nil, szRenTo));
- finally
- Close;
- TableName := RenameTo;
- Exclusive := SaveExcl;
- Active := SaveActive;
- end;
- end;
- {$ENDIF}
-
- procedure TjocTable2.CopyTable(const Destination: string);
- var szCopyFrom, szCopyTo: DBITBLNAME;
- begin
- if State = dsInactive then DBError(SDataSetClosed);
- try
- LockTable(ltReadLock);
- AnsiToNative(Locale, Destination, szCopyTo, sizeof(szCopyTo)-1);
- AnsiToNative(Locale, TableName, szCopyFrom, sizeof(szCopyFrom)-1);
- Check(DbiCopyTable(Database.Handle, True, szCopyFrom, nil, szCopyTo));
- finally
- UnLockTable(ltReadLock);
- end;
- end;
-
- procedure TjocTable2.RebuildIndexes;
- begin
- CheckRemote;
- CheckActiveExclusive;
- Check(DbiRegenIndexes(Handle));
- end;
-
- procedure TjocTable2.RebuildIndex(const Idx: word);
- var IDesc: IDXDesc;
- begin
- CheckRemote;
- if (Idx <= 0) then
- DatabaseError('Invalid index sequence number');
- CheckActiveExclusive;
- IndexDefs.Update;
-
- if (Idx <= IndexDefs.Count) then
- begin
- Check(DbiGetIndexDesc(Handle, Idx, IDesc));
- Check(DbiRegenIndex(Database.Handle, Handle, nil,
- nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexID));
- end else
- DataBaseError('Index not found');
- end;
-
- procedure TjocTable2.RebuildNamedIndex(const IdxName: TDbiNameStr);
- var IDesc: IDXDesc;
- Idx: Integer;
- wIdx: Word;
- begin
- CheckRemote;
- CheckActiveExclusive;
- IndexDefs.Update;
- Idx := IndexDefs.IndexOf(IdxName);
-
- if (Idx >= 0) then
- begin
- wIdx := Succ(Idx);
- Check(DbiGetIndexDesc(Handle, wIdx, IDesc));
- Check(DbiRegenIndex(Database.Handle, Handle, nil,
- nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexId));
- end else
- DatabaseError('Index not found');
- end;
-
- procedure Register;
- begin
- RegisterComponents('JOC', [TjocTable2]);
- end;
-
- end.
-